{-# LANGUAGE CPP, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, DeriveFunctor #-}
{- |
Module      :  Survey
Description :  <optional short text displayed on contents page>
Copyright   :  (c) Sergey Sichevskiy 2013
License     :  BSD3

Maintainer  :  s.sichevskij@gmal.com
Stability   :  experimental
Portability :  portable

-}



module Survey where

import Helper

import Control.Applicative
--import Control.DeepSeq (NFData(..))
import Data.HList
import Text.Printf (printf)

type Val = Maybe Double --deriving (Show, Num)

class Survey s where

-- Блески
data I s = I s Val deriving (Show,Functor)
data J s = J s Val deriving (Show,Functor)
data H s = H s Val deriving (Show,Functor)
data K s = K s Val deriving (Show,Functor)
data W s = W s Val deriving (Show,Functor)
data B s = B s Val deriving (Show,Functor)
data V s = V s Val deriving (Show,Functor)
data R s = R s Val deriving (Show,Functor)

-- Цвета
data IJ s = IJ s Val deriving (Show,Functor)
data IK s = IK s Val deriving (Show,Functor)
data JH s = JH s Val deriving (Show,Functor)
data JK s = JK s Val deriving (Show,Functor)
data WB s = WB s Val deriving (Show,Functor)
data WV s = WV s Val deriving (Show,Functor)
data WR s = WR s Val deriving (Show,Functor)
data BV s = BV s Val deriving (Show,Functor)
data BR s = BR s Val deriving (Show,Functor)
data VR s = VR s Val deriving (Show,Functor)

instance Num Val where
  negate      = fmap negate
  (+)         = liftA2 (+)
  (*)         = liftA2 (*)
  fromInteger = pure . fromInteger
  abs         = fmap abs
  signum      = fmap signum

instance Fractional Val where
  fromRational  = pure . fromRational
  recip = fmap recip

#define NUMERIC(T)                                                      \
instance HApplay ToDouble (T s) where { applay _ (T _ v) = maybe 0 id v }

NUMERIC (V )
NUMERIC (IJ)
NUMERIC (IK)
NUMERIC (JH)
NUMERIC (JK)
NUMERIC (WB)
NUMERIC (WV)
NUMERIC (WR)
NUMERIC (BV)
NUMERIC (BR)
NUMERIC (VR)

{--
#define NFDATA(T)                                                  \
instance NFData (T) where { rnf (T (Just v)) = rnf v; rnf (T Nothing) = () }

NFDATA (W  s)
NFDATA (IJ s)
NFDATA (IK s)
NFDATA (JH s)
NFDATA (JK s)
NFDATA (WB s)
NFDATA (WV s)
NFDATA (WR s)
NFDATA (BV s)
NFDATA (BR s)
NFDATA (VR s)
--}

#define NUM(T, S)                            \
instance Num (T S) where                     \
  negate (T S a)      = T S $ negate a      ;\
  (+) (T S a) (T _ b) = T S $ a+b           ;\
  (*) (T S a) (T _ b) = T S $ a*b           ;\
  fromInteger a       = T (undefined::S) $ fromInteger a ;\
  abs (T S a)         = T S $ abs a         ;\
  signum (T S a)      = T S $ signum a

NUM (V, s)
NUM (IJ, s)
NUM (IK, s)
NUM (JH, s)
NUM (JK, s)
NUM (WB, s)
NUM (WV, s)
NUM (WR, s)
NUM (BV, s)
NUM (BR, s)
NUM (VR, s)

#define PRETTYSHOW(TA, TB)                                                          \
instance Show TB => PrettyShow (TA TB)                                              \
   where                                                                            \
      prettyShow (TA TB (Just v)) = printf "%s %3s %10.7f"(show TB) "TA" v         ;\
      prettyShow (TA TB  Nothing) = printf "%s %3s %10s"  (show TB) "TA" "Nothing"

PRETTYSHOW (V,  s)
PRETTYSHOW (IJ, s)
PRETTYSHOW (IK, s)
PRETTYSHOW (JH, s)
PRETTYSHOW (JK, s)
PRETTYSHOW (WB, s)
PRETTYSHOW (WV, s)
PRETTYSHOW (WR, s)
PRETTYSHOW (BV, s)
PRETTYSHOW (BR, s)
PRETTYSHOW (VR, s)